home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / post.tcl.z / post.tcl
Text File  |  2002-07-08  |  8KB  |  290 lines
  1. #
  2. # post.tcl  -  news posting client for exmh
  3. # Needs tcl7.5/tk4.1 or above.
  4. # 
  5. # Gareth Owen (g.owen@aston.ac.uk)
  6. # 20-Dec-96
  7.  
  8.  
  9. proc Post_Init {} {
  10.  
  11.     global NNTP
  12.  
  13.     Preferences_Add "NNTP Support" \
  14. "Post a mail message to a Usenet news server via NNTP
  15. (mainly intended to take the grind out of moderating newsgroups),
  16. and retrieve new articles from selected newsgroups." {
  17.     {NNTP(host) nntpHost {news} {News Server}
  18. "The name of your usenet news server. Very often 'news'. "}
  19.     {NNTP(port) nntpPort {119}  {NNTP port}
  20. "Port on which the news server listens for nntp connections. 
  21. 119 unless your site is weird"}
  22.     {NNTP(emailaddr) nntpEmailAddr {}  {My address when posting}
  23. "E-mail address to use when posting to newsgroups.
  24. Typically: First Last <login@domain>"}
  25.      {NNTP(user) nntpUser {} {NNTP Username}
  26. "If your news server requires you to authenticate put your
  27. username here else leave blank"}
  28.     {NNTP(pass) nntpPass {} {NNTP Password}
  29. "If your news server requires you to authenticate put your
  30. password here. Ignored unless Username is defined."}
  31.    {NNTP(moderated) nntpModerated {} {Groups you moderate}
  32. "A list of groups which you moderate separated by whitespace.
  33. If one of these is in the Newsgroups header then an Approved
  34. header will be added to the posting"}
  35.     {NNTP(moderator) nntpModerator {} {Moderator's address}
  36. "Address to put in the Approved: field for moderated groups.
  37. Not needed if the moderated list is empty"}
  38.     {NNTP(groups) nntpNewsGroups {} {Groups to retrieve}
  39. "A list of groups which you wish to be retrieved when the
  40. \"News\" button is clicked on"}
  41.     {NNTP(newsrc) nntpDotnewsrc {~/.newsrc} {.newsrc file}
  42. "Pathname of your .newsrc file (or equivalent).  If it does not
  43. exist, it will be created.  Defaults to ~/.newsrc"}}
  44. }
  45.  
  46. #
  47. #  Parse mail and sort out what we need
  48. #
  49. proc Post {} {
  50.  
  51.     global NNTP msg env
  52.  
  53.     if [string length $msg(path)] {
  54.          set art [open $msg(path) r]
  55.         set text [read $art]
  56.         close $art
  57.     } else {
  58.     Exmh_Status "Post - no message selected"
  59.     Post_Dismiss
  60.     return
  61.     }
  62.  
  63.     # Headers to throw away since they'll be added anew by INN
  64.     # and CNews which get upset when they can't do it
  65.     set header_throwAway \
  66.     {{return-path:} {received:} {path:} {date:} {message-id:} {to:} \
  67.          {lines:} {x-exmh-isig-} {cc:} {from }}
  68.  
  69.     # Headers INN wants to add  itself get X-original- shoved in front
  70.     # if we want to keep them
  71.     # else MUST be in above else INN will reject post
  72.     # (but NNTP/Cnews doesn't complain about following)
  73.     set header_Xify \
  74.     {{nntp-posting-host:}}
  75.  
  76.     #  split header from body
  77.     set sp [string first "\n\n" $text]
  78.     set spmh [string first "\n--------\n" $text]
  79.     if {$sp < 0 || ($spmh > 0 && $spmh < $sp)} {
  80.     set sp $spmh
  81.     set hdr [string range $text 0 [incr sp -1]]
  82.     set NNTP(body) [string range $text [incr sp 11] end]
  83.     } else {
  84.     set hdr [string range $text 0 [incr sp -1]]
  85.     set NNTP(body) [string range $text [incr sp 3] end]
  86.     }
  87.  
  88.     set headerin [split $hdr \n]
  89.     set NNTP(headers) {}
  90.     set flag 0
  91.     set NNTP(post_groups) $NNTP(groups)
  92.     set NNTP(sender) $NNTP(emailaddr)
  93.     set organization 0
  94.  
  95.     # parse headers and dispose of as necessary
  96.     foreach h $headerin {
  97.     if {$flag} {
  98.         set fstch [string index $h 0]
  99.         if {$fstch == { } || $fstch == {    }} {
  100.         continue
  101.         }
  102.     }
  103.     set lh [string tolower $h]
  104.     set flag 0
  105.     foreach t $header_throwAway {
  106.         if {[string first [string tolower $t] $lh]==0} {
  107.         set flag 1
  108.         break
  109.         }
  110.     }
  111.     if {$flag==0} {
  112.         foreach t $header_Xify {
  113.         if {[string first [string tolower $t] $lh]==0} {
  114.             set h "X-original-$h"
  115.             break
  116.         }
  117.         }
  118.     }
  119.     if {$flag} {
  120.         continue
  121.     } elseif {[string first from: $lh]==0} {
  122.         set NNTP(sender) [string trim [string range $h 5 end]]
  123.     } elseif {[string first newsgroups: $lh]==0} {
  124.         set NNTP(post_groups) [string trim [string range $h 11 end]]
  125.     } elseif {[string first subject: $lh]==0} {
  126.         set NNTP(subject) [string trim [string range $h 8 end]]
  127.     } elseif {[string first organization: $lh]==0} {
  128.         set organization 1
  129.     } else {
  130.         lappend NNTP(headers) $h
  131.     }
  132.     }
  133.     if {$organization==0 && [info exists env(ORGANIZATION)]} {
  134.     set org_hdr "Organization: $env(ORGANIZATION)"
  135.     lappend NNTP(headers) $org_hdr
  136.     }
  137.  
  138.     Post_Widget
  139.  
  140. }
  141.  
  142.  
  143. #
  144. # Create the widget
  145. #
  146. proc Post_Widget {} {
  147.  
  148.     global NNTP
  149.  
  150.     if [Exwin_Toplevel .exmh_post "Post Article to NewsGroup" PostNews] {
  151.  
  152.     .exmh_post.but.quit config -command Post_Dismiss
  153.  
  154.     wm protocol .exmh_post WM_DELETE_WINDOW Post_Dismiss
  155.         Widget_AddBut .exmh_post.but post "Post" Post_Article
  156.  
  157.     frame .exmh_post.ng  -borderwidth 2
  158.     label .exmh_post.ng.l -text Newsgroups: -width 12
  159.     entry .exmh_post.ng.e -textvariable NNTP(post_groups) \
  160.         -relief sunken -width 60
  161.     pack .exmh_post.ng.l -side left -fill both
  162.     pack .exmh_post.ng.e -side left -fill both -expand 1
  163.     pack .exmh_post.ng -expand 1 -fill both
  164.     frame .exmh_post.f -borderwidth 2
  165.     label .exmh_post.f.l -text From: -width 12
  166.     entry .exmh_post.f.e -textvariable NNTP(sender)
  167.     pack .exmh_post.f.l -side left -fill both
  168.     pack .exmh_post.f.e -side left -expand 1 -fill both
  169.     pack .exmh_post.f -side top -expand 1 -fill both
  170.     frame .exmh_post.s -borderwidth 2
  171.     label .exmh_post.s.l -text Subject: -width 12
  172.     entry .exmh_post.s.e -textvariable NNTP(subject)
  173.     pack .exmh_post.s.l -side left -fill both
  174.     pack .exmh_post.s.e -side left -fill both -expand 1
  175.     pack .exmh_post.s -side top -expand 1 -fill both
  176.     
  177.     }
  178. }
  179.  
  180.  
  181.  
  182.  
  183. #
  184. # Construct the article to be posted and invoke poster
  185. #
  186. proc Post_Article {} {
  187.  
  188.     global NNTP
  189.  
  190. # Have we got the essentials ?
  191.     if {! [expr \
  192.       "[string length $NNTP(sender)] && [string length $NNTP(subject)] && [string length $NNTP(post_groups)]"\
  193.           ] } {
  194.     Exmh_Status "Newsgroups , Subject  and From fields are NOT optional"
  195.     return
  196.     }
  197.  
  198.     set head [list "From: $NNTP(sender)" "Subject: $NNTP(subject)" \
  199.           "Newsgroups: $NNTP(post_groups)"]
  200.  
  201. # Is there a moderated group in the list of those we're posting to ?
  202.     set postingTo [split $NNTP(post_groups) ,]
  203.     foreach i $NNTP(moderated) {
  204.     if {[lsearch $postingTo $i]>-1} {
  205.         lappend head "Approved: $NNTP(moderator)"
  206.         break
  207.     }
  208.     }
  209.  
  210. # Join them all up
  211.     regsub "\[ \t\n\]*\$" $NNTP(body) {} body
  212.     set article "[join [concat $head $NNTP(headers)] \n]\n\n$body"
  213.  
  214. # And off we go
  215.     Exmh_Status "Post Article : [busy PostIt $article]"
  216.  
  217.     if [winfo exists .exmh_post] {
  218.         Exwin_Dismiss .exmh_post
  219.     }
  220. }
  221.  
  222. #
  223. # NNTP posting client
  224. #
  225. proc PostIt {article} {
  226.     
  227.     global NNTP
  228.     
  229.     if { [catch {socket $NNTP(host) $NNTP(port)} conn] } {
  230.     return $conn
  231.     }
  232.  
  233.     set line [NNTPReply $conn]
  234.     if {[string first 200 $line]} {
  235.     NNTPCommand $conn QUIT
  236.     close $conn
  237.     return $line
  238.     }
  239.  
  240.     NNTPCommand $conn POST
  241.  
  242.     set line [NNTPReply $conn]
  243.     if {[string first 340 $line]} {
  244.     set ok 0
  245.     if ![string first 480 $line] {
  246.         set ok [NNTPAuthenticate $conn]
  247.         if $ok {
  248.         NNTPCommand $conn POST
  249.         set line [NNTPReply $conn]
  250.         if [string first 340 $line] {
  251.             set ok 0
  252.         }
  253.         }
  254.     }    
  255.     if {!$ok} {
  256.         NNTPCommand $conn QUIT
  257.         close $conn
  258.         return $line
  259.     }
  260.     }
  261.  
  262.     puts $conn "$article\n.\n"
  263.     flush $conn
  264.     set line [NNTPReply $conn]
  265.     if {[string first 240 $line]} {
  266.     NNTPCommand $conn QUIT
  267.     close $conn
  268.     return $line
  269.     }
  270.     
  271.     NNTPCommand $conn QUIT
  272.     set line [NNTPReply $conn]
  273.     if {[string first 205 $line]} {
  274.     NNTPCommand $conn QUIT
  275.     close $conn
  276.     return $line
  277.     }
  278.     
  279.     close $conn
  280.     return "Posted Successfully"
  281.  
  282. }
  283.  
  284. proc Post_Dismiss {} {
  285.     if [winfo exists .exmh_post] {
  286.     Exwin_Dismiss .exmh_post
  287.     }
  288. }
  289.  
  290.